library(sp)
library(sf)
## Linking to GEOS 3.6.1, GDAL 2.1.3, PROJ 4.9.3
# library(raster)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyr)
library(ggplot2)
library(ggforce)
library(stringr)
load(file = "data/Part3_res_dataset.Rdata")
load("data/settlements.Rdata")
clusters_18_metrics %>%
select(clust_18, CL18_variance_2002, CL18_variance_2010) %>%
gather(Year, Variance, CL18_variance_2002:CL18_variance_2010) %>%
mutate(Year = as.integer(str_extract(Year, "\\d{4}"))) %>%
ggplot(aes(x = clust_18, y = Variance, fill = as.factor(Year)))+
geom_col(position = position_dodge())+
scale_x_continuous(breaks = 1:18)
Вывод 1: во всех кластерах территориальная дифференциация расселения увеличилась (то есть расселение сжималось)
ggplot()+
geom_sf(data = st_as_sf(region), fill = "white")+
geom_point(data = df, aes(x = lon, y = lat, col = CL18_variance_2010))+
# geom_raster(data = df, aes(x = lon, y = lat, fill = CL18_variance_2010))+
scale_color_viridis_c()
Самая высокая дифференциация расселения у кластеров вокруг городов (Тюмень, Тобольск, Ишим), далее идут 11 кластер (Ялуторовск, Заводоуковск, Упорово), затем Голышманово и Викулово+Сорокино. Самые низкие показатели вариации - в Исетском районе, а также на ЮВ - в Казанском, Бердюжском, Сладковском и Абатском районах + в бывшем Байкаловском районе.
Да, более восточные (за исключением Ишимског района) и северные (за исключением Уватского и Вагайского районов) сжимаются быстрее. Кроме того, на карте явно выделяется субширотная транспортная ось - районы вдоль нее - Омутинский, Голышмановский, Ишимский - сжимаются медленне, районы в стороне от оси, как к северу, так и к югу - быстрее.
p1 <- clusters_18_metrics %>%
ggplot(aes(y = CL18_pop2010to2002_rel, x = CL18_dist2Tyumen/1000))+
geom_point()+
geom_smooth(method = "glm", color = "red", se = F)+
scale_x_continuous(name = "Расстояние до регионального центра, км")+
scale_y_continuous(name = "Население, 2010 г. к 2002 г., %")+
theme_minimal()
p2 <- ggplot()+
geom_sf(data = st_as_sf(region), fill = "white")+
geom_point(data = df, aes(x = lon, y = lat, col = CL18_variance_dif),size = 0.8)+
scale_color_viridis_c(name = "Вариация в распределении\nнаселения по н.п., 2010 к 2002, %")+
theme_minimal()+
theme(legend.position = "bottom",
axis.title = element_blank())
gridExtra::grid.arrange(p1,p2, nrow = 1)
Рост численности населения формирует обратный сжатию расселения пространственный градиент
ggplot()+
geom_sf(data = st_as_sf(region), fill = "white")+
geom_point(data = df, aes(x = lon, y = lat, col = CL18_pop2010to2002_rel))+
# geom_raster(data = df, aes(x = lon, y = lat, fill = CL18_pop2010to2002_rel))+
scale_color_viridis_c()
По интенсивности депопуляции и сжатия расселения кластеры разибваются на две примерно равные группы. В ситуации роста или слабой депопуляции (A) контрастность расселения растет медленно. Сокращение населения (Б), напротив, сопровождается интенсивным сжатием расселения в пределах кластеров; таким образом, крупные н.п. становятся относительно крупнее, мелкие - относительно мельче, а кластер в целом - более территориально дифференцированным.
x_ticks <- 80:105
x_ticks[-seq(1, 26, 5)] <- ""
y_ticks <- 100:117
y_ticks[-seq(1,17,5)] <- ""
clusters_18_metrics %>%
ggplot(aes(x = CL18_pop2010to2002_rel, y = CL18_variance_dif))+
geom_point(aes(size = CL18_pop2002/1000))+
geom_circle(data = data_frame(x = c(90, 98), y = c(112, 104)),
mapping = aes(x0 = x, y0 = y, r = 5.6),
color = "grey70",linetype = "dotted", alpha = 1,
inherit.aes = F)+
annotate("text", x = 99, y = 108.5, label = "A")+
annotate("text", x = 91, y = 116, label = "B")+
scale_x_continuous(name = "Население в 2010 г. к населению в 2002, %",
breaks = 80:105, labels = x_ticks)+
scale_y_continuous(name = "Динамика территориальной дифференциации \n расселения, 2010 к 2002, %",
breaks = 100:117, labels = y_ticks)+
scale_size_continuous(name = "Численность\nнаселения,\n2002 г., тыс. чел.", breaks = c(20, 50, 100, 200, 500))+
theme_bw()+
theme(panel.grid = element_blank(),
axis.ticks = element_line())
## Warning: `data_frame()` is deprecated, use `tibble()`.
## This warning is displayed once per session.
Различия между районами есть
df %>%
ggplot()+
geom_sf(data = st_as_sf(region), fill = "white")+
geom_point(aes(x = lon, y = lat, col = CL18_density))+
scale_color_viridis_c()
Чем выше плотность графа, тем сильнее сжатие сети (?).
clusters_18_metrics %>%
ggplot(aes(x = CL18_density, y = CL18_variance_dif))+
# geom_smooth()+
geom_point(aes(size = CL18_mean_pop2002))+
geom_text(aes(x = CL18_density, y = CL18_variance_dif + 0.5, label = clust_6))
А как насчет связи плотности сети и общей динамики населения?
clusters_18_metrics %>%
ggplot(aes(x = CL18_density, y = CL18_pop2010to2002_rel))+
geom_point(aes(size = CL18_mean_pop2002))+
# geom_smooth(col = "grey")+
geom_text(aes(x = CL18_density+0.001, y = CL18_pop2010to2002_rel - 0.5, label = clust_18))
Мораль, видимо, в том, что показатель плотности графа обратно пропорционален числу н.п., входящих в граф. В итоге, крупные кластеры, например 11, получили низкое значение плотности.
df %>%
group_by(clust_18) %>%
summarise(n = n()) %>%
left_join(clusters_18_metrics, by = c("clust_18")) %>%
ggplot()+
geom_point(aes(x = n, y = CL18_density))
Вопрос: есть ли смысл использовать этот показатель далее или следует его заменить?
В качестве альтернативы density можно использовать медианну пути между н.п. в кластерах. Она также показывает, насколько “плотно” расположены н.п., но проще интерпретируема.
clusters_18_metrics %>%
ggplot(aes(x = CL18_median_path/1000, y = CL18_density))+
# geom_smooth()+
geom_point(aes(size = CL18_mean_pop2002))
# Корреляция
cor(clusters_18_metrics$CL18_density, clusters_18_metrics$CL18_median_path)
## [1] -0.7303862
Существуют ли пространственные закономерности в распределении показателя между кластерами?
df %>%
ggplot()+
geom_sf(data = st_as_sf(region), fill = "white")+
geom_point(aes(x = lon, y = lat, col = CL18_median_path/1000))+
scale_color_viridis_c(name = "Медиана пути\nмежду н.п., км",
limits = c(20, 70),
breaks = seq(20,70, 10))
Пространственный закономерностей нет.
Есть ли связь между медианной длиной пути и сжатием расселения?
clusters_18_metrics %>%
ggplot(aes(x = CL18_median_path/1000, y = CL18_variance_dif))+
# geom_smooth()+
geom_point(aes(size = CL18_mean_pop2002))+
geom_text(aes(x = CL18_median_path/1000+1, y = CL18_variance_dif + 0.5, label = clust_18))
Связи не вижу
Между динамикой населения и длиной пути тоже не видно ссвязи, но, кажется, тут есть какие-то группы?
clusters_18_metrics %>%
ggplot(aes(x = CL18_median_path/1000, y = CL18_pop2010to2002_rel, col = as.factor(clust_6)))+
# geom_smooth()+
geom_point(aes(size = CL18_mean_pop2002))
В целом, картинки очень похожи. Хотя забавно, что кластеры с городами в итоге менее централизованы, чем кластеры вокруг районных центров.
Централизация по близости
ggplot()+
geom_sf(data = st_as_sf(region), fill = "white")+
geom_point(data = df, aes(x = lon, y = lat, col = CL18_centr_clo), inherit.aes = F)+
scale_color_viridis_c()
Централизация по посредничеству
ggplot()+
geom_sf(data = st_as_sf(region), fill = "white")+
geom_point(data = df, aes(x = lon, y = lat, col = CL18_centr_betw), inherit.aes = F)+
scale_color_viridis_c()
Посмотрим на связь с темпами сжатия расселения
clusters_18_metrics %>%
ggplot(aes(x = CL18_centr_clo, y = CL18_variance_dif, col = as.factor(clust_6)))+
# geom_smooth()+
geom_point(aes(size = CL18_mean_pop2002))+
geom_text(aes(x = CL18_centr_clo+0.001, y = CL18_variance_dif + 0.5, label = clust_18))
clusters_18_metrics %>%
ggplot(aes(x = CL18_centr_betw, y = CL18_variance_dif, col = as.factor(clust_6)))+
# geom_smooth()+
geom_point(aes(size = CL18_mean_pop2002))+
geom_text(aes(x = CL18_centr_betw+0.001, y = CL18_variance_dif + 0.5, label = clust_18))
В общем то, никакой особой связи я тут не вижу
clusters_18_metrics %>%
select(CL18_pop2010to2002_rel, CL18_variance_2002, CL18_variance_dif, CL18_density, CL18_centr_betw, CL18_centr_clo, CL18_median_path, CL18_dist2Tyumen) %>%
cor(method = "pearson") %>% corrplot::corrplot(method = "number")
## Adding missing grouping variables: `clust_18`